by Gabriel Tavares de Oliveira Castellani (5 Submissions)
Category: String Manipulation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 26th August 2004
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Formats a number into a dd/mm/yyyy formated date. Ex.: 2 -> 02/01/2004; 22 -> 02/02/2004; 235 -> 02/03/2005; 1234 -> 12/03/2004; 011105
API Declarations
'Usage: Text1.Text = FormataData(Text1.Text)
VBcoders
'Function FormataData()
'Gabriel Tavares de Oliveira Castellani
'Formata uma string (Data) numérica para o padrão de data
'Retorna Data formatado em dd/mm/yyyy
Function FormataData(ByVal Data As String) As String
Dim Resp As String
Dim Tamanho As Integer
Data = ConverteParaNumero(Data)
Tamanho = Len(Data)
If Tamanho = 0 Then
Resp = Format$(Now, "dd/mm/yyyy")
ElseIf Tamanho = 1 Then
Resp = "0" & Data & Format$(Now, "/mm/yyyy")
ElseIf Tamanho = 2 Then
'Se o tamanho da string for 2, tipo "24",
'então sei que 2 é o dia, 4 o mês e o ano vai ser 2000.
'Então separe direto (caso especial).
Resp = "0" & Left$(Data, 1) & "/0" & Mid$(Data, 2, 1) & Format$(Now, "/yyyy")
'Verificando as datas
ElseIf Tamanho = 3 Then
'Se o tamanho da string for 3, tipo "241",
'então sei que 2 é o dia, 4 o mês e 1 (2001) o ano.
'Então separe direto (caso especial).
Resp = "0" & Left$(Data, 1) & "/0" & Mid$(Data, 2, 1) & "/200" & Right$(Data, 1)
ElseIf Tamanho = 4 Then
'Se o tamanho da string for 4, tipo "2474",
'então sei que 2 é o dia, 4 o mês e 74 o ano.
'Neste caso, o ano tem que ser verificado: se maior ou igual a 29, então é 19XX, senão é 20XX.
'Ainda assim separe direto (caso especial).
Resp = "0" & Left$(Data, 1) & "/0" & Mid$(Data, 2, 1)
If Val(Right$(Data, 2)) >= 29 Then
Resp = Resp & "/19" & Right$(Data, 2)
Else
Resp = Resp & "/20" & Right$(Data, 2)
End If
ElseIf Tamanho > 4 Then
'Aqui o bicho pega. O tamanho da string só pode ser maior que 4 (5, 6, 7 ou 8).
'Então assume-se que os 2 últimos dígitos são o ano.
'Verificando o ano
Resp = Right$(Data, 2)
'Agora, analisam-se os 2 seguintes, verificando se são 19 ou 20. A finalidade é descobrir
'se o usuário digitou ano de 2 ou 4 dígitos.
If Val(Mid$(Data, Tamanho - 3, 2)) = 19 Or Val(Mid$(Data, Tamanho - 3, 2)) = 20 And Tamanho >= 6 Then
'Entra aqui se o ano for de 4 dígitos
Resp = Mid$(Data, Tamanho - 3, 2) & Resp
Tamanho = Tamanho - 4
Else
'Entra aqui se o ano for de 2 dígitos
If Val(Resp) >= 29 Then
Resp = "19" & Resp
Else
Resp = "20" & Resp
End If
Tamanho = Tamanho - 2
End If
Resp = "/" & Resp
'Note que em ambos os casos acima, tamanho foi diminuído do nº de dígitos do ano. Isto é para facilitar
'a busca pelos dígitos do mês.
'Muito bem. Se a string restante (ou seja, tamanho) for igual a 2, assume-se, com segurança
'que o primeiro dígito é o dia e o segundo o mês. Caso especial
If Tamanho = 2 Then
Resp = "0" & Left$(Data, 1) & "/0" & Mid$(Data, 2, 1) & Resp
Else
'Se tamanho for maior que 2, então verificamos se os dois últimos dígitos são maiores que 12.
If Val(Mid$(Data, Tamanho - 1, 2)) > 12 Then
'Se forem, assumimos 1ue apenas o último é o mês, e os dois anteriores o dia.
Resp = Mid$(Data, Tamanho - 2, 2) & "/0" & Mid$(Data, Tamanho, 1) & Resp
Else
'Se não forem, temos ainda que verificar se o dia tem comprimento 2 ou 1.
'Então verificamos se tamanho é 3 ou maior.
If Tamanho = 3 Then
'Se três, dia tem comprimento 1
Resp = "0" & Mid$(Data, Tamanho - 2, 1) & "/" & Mid$(Data, Tamanho - 1, 2) & Resp
Else
'Senão, tem comprimento 2
Resp = Mid$(Data, Tamanho - 3, 2) & "/" & Mid$(Data, Tamanho - 1, 2) & Resp
End If
End If
End If
End If
On Error Resume Next
Dim CData As Date
CData = CDate(Resp)
If Err <> 0 Then
MsgBox "A data é inválida!", 48, "Data inválida"
Resp = Format$(Now, "dd/mm/yyyy")
End If
'Agora atualiza o TEXT com o valor de Resp
FormataData = Resp
End Function
'Function ConverteParaNumero()
'Gabriel Tavares de Oliveira Castellani
'Pega uma string (COD) de qualquer formato e extrai dela
'somente os algarismos.
'Retorna uma string com estes algarismos
Function ConverteParaNumero(ByVal cod As String) As String
Dim i As Integer
For i = 1 To Len(cod)
If InStr("0123456789", Mid$(cod, i, 1)) <> 0 Then
ConverteParaNumero = ConverteParaNumero & Mid$(cod, i, 1)
End If
Next
End Function
No comments have been posted about Formats a number into a dd/mm/yyyy formated date. Ex.: 2 -> 02/01/2004; 22 -> 02/02/2004; 235 -> 02. Why not be the first to post a comment about Formats a number into a dd/mm/yyyy formated date. Ex.: 2 -> 02/01/2004; 22 -> 02/02/2004; 235 -> 02.
